﻿Imports System
Imports System.Data
Imports System.Data.SqlClient
Imports System.Data.SqlTypes
Imports Microsoft.SqlServer.Server
Imports Microsoft.AnalysisServices.AdomdClient
Imports System.Security.Principal


Partial Public Class StoredProcedures

#Region "ExecuteOLAP"
    <Microsoft.SqlServer.Server.SqlProcedure()> _
    Public Shared Sub ExecuteOLAP(ByVal server As SqlString, ByVal database As SqlString, <SqlFacet(MaxSize:=-1)> ByVal MDX As String)
        Dim currentIdentity As WindowsIdentity = SqlContext.WindowsIdentity
        Dim impersonatedIdentity As WindowsImpersonationContext = currentIdentity.Impersonate()
        Dim dt As DataTable = New DataTable("OLAPResults")

        Try
            Dim olapCellSet As CellSet

            Using conn As New AdomdConnection("Data Source=" + server.ToString() + ";Initial Catalog=" + database.ToString() + "; MDX Compatibility=1;")
                conn.Open()

                Using cmd As New AdomdCommand(MDX, conn)
                    olapCellSet = cmd.ExecuteCellSet()
                    dt = ConvertCellSetToDataTable(olapCellSet)
                End Using
            End Using

            impersonatedIdentity.Undo()
            SendDataTable(dt)

        Catch ex As Exception
            If impersonatedIdentity IsNot Nothing Then
                impersonatedIdentity.Undo()
            End If
            SqlContext.Pipe.Send(ex.Message)
            Throw New System.Exception(ex.Message)
        Finally
            impersonatedIdentity.Undo()
        End Try



    End Sub
#End Region

#Region "ExecuteOLAPDMV"
    <Microsoft.SqlServer.Server.SqlProcedure()> _
    Public Shared Sub ExecuteOLAPDMV(ByVal server As SqlString, ByVal database As SqlString, <SqlFacet(MaxSize:=-1)> ByVal MDX As String)
        Dim currentIdentity As WindowsIdentity = SqlContext.WindowsIdentity
        Dim impersonatedIdentity As WindowsImpersonationContext = currentIdentity.Impersonate()
        Try
            Dim dt As DataTable = New DataTable("OLAPResults")

            Using conn As New AdomdConnection("Data Source=" + server + ";Initial Catalog=" + database + "; MDX Compatibility=1;")
                conn.Open()
                Using cmd As New AdomdCommand(MDX, conn)
                    Using adapter As New AdomdDataAdapter(cmd)
                        adapter.Fill(dt)
                    End Using
                End Using
            End Using
            impersonatedIdentity.Undo()
            SendDataTable(dt)

        Catch ex As Exception
            If impersonatedIdentity IsNot Nothing Then
                impersonatedIdentity.Undo()
            End If
            SqlContext.Pipe.Send(ex.Message)
            Throw New System.Exception(ex.Message)
        End Try

    End Sub
#End Region

#Region "ExecuteXMLA"
    <Microsoft.SqlServer.Server.SqlProcedure()> _
    Public Shared Sub ExecuteXMLA(ByVal server As SqlString, ByVal database As SqlString, <SqlFacet(MaxSize:=-1)> ByVal XMLA As String)
        Dim currentIdentity As WindowsIdentity = SqlContext.WindowsIdentity
        Dim impersonatedIdentity As WindowsImpersonationContext = currentIdentity.Impersonate()

        Try

            Using conn As New AdomdConnection("Data Source=" + server.ToString() + ";Initial Catalog=" + database.ToString() + "; MDX Compatibility=1;")
                conn.Open()

                Using cmd As New AdomdCommand(XMLA, conn)
                    cmd.ExecuteNonQuery()
                End Using
            End Using

            impersonatedIdentity.Undo()

        Catch ex As Exception
            If impersonatedIdentity IsNot Nothing Then
                impersonatedIdentity.Undo()
            End If
            SqlContext.Pipe.Send((ex.Message).Substring(0, 4000))
            Throw New System.Exception(ex.Message)
        Finally
            impersonatedIdentity.Undo()
        End Try



    End Sub
#End Region

    Private Shared Function ConvertCellSetToDataTable(cs As CellSet) As DataTable
        Dim dt As New DataTable()
        Dim dc As DataColumn = Nothing
        Dim dr As DataRow = Nothing
        Dim pos As Integer = 0
        Dim AxesCount As Integer = cs.Axes.Count
        Dim MemberCount As Integer = cs.Axes(0).Positions.Count
        Dim MemberRowCount As Integer = cs.Axes(0).Set.Hierarchies.Count
        Dim columnName As String = ""

        'Get number of columns to return
        Dim ColCount As Integer = cs.Axes(0).Positions.Count 'Columns
        Dim RowCount As Integer = 0

        If AxesCount > 1 Then
            RowCount = cs.Axes(1).Set.Hierarchies.Count 'Rows
        End If


        If AxesCount > 1 Then
            'Column names for rows
            For i As Integer = 0 To (RowCount - 1)
                dc = New DataColumn()
                dc.ColumnName = cs.Axes(1).Set.Hierarchies(i).UniqueName & ".[" & cs.Axes(1).Set.Hierarchies(i).Name & "].[MEMBER_CAPTION]"
                dt.Columns.Add(dc)
            Next
        End If

        'Column names for members
        For i As Integer = 0 To (ColCount - 1)
            dc = New DataColumn()
            columnName = "("
            If MemberRowCount = 1 Then
                columnName = cs.Axes(0).Positions(i).Members(0).UniqueName
            Else
                For mrc As Integer = 0 To (MemberRowCount - 1)
                    columnName += cs.Axes(0).Positions(i).Members(mrc).Name + ","
                Next
                columnName = columnName.Substring(0, columnName.Length - 1) + ")"
            End If
            dc.ColumnName = If(columnName.Length > 128, columnName.Substring(0, (126 - i.ToString.Length)) + i.ToString() + "])", columnName)
            dt.Columns.Add(dc)
        Next

        If AxesCount > 1 Then
            For Each py As Position In cs.Axes(1).Positions 'for each recordset
                dr = dt.NewRow()

                For i As Integer = 0 To (RowCount - 1) 'for each row
                    dr(i) = cs.Axes(1).Positions(pos).Members(i).Caption
                Next

                For i As Integer = 0 To (ColCount - 1) 'for each column
                    dr(i + (RowCount)) = cs(i, pos).Value
                Next

                dt.Rows.Add(dr)
                pos = pos + 1

            Next
        Else
            dr = dt.NewRow()
            For i As Integer = 0 To (ColCount - 1) 'for each column
                dr(i) = If(cs(i).FormattedValue = "", cs(i).Value, cs(i).FormattedValue)

            Next
            dt.Rows.Add(dr)
        End If

        Return dt
    End Function

    Private Shared Sub SendDataTable(dt As DataTable)
        Dim coerceToString As Boolean()
        ' Do we need to coerce this column to string? 
        Dim metaData As SqlMetaData() = ExtractDataTableColumnMetaData(dt, coerceToString)

        Dim record As New SqlDataRecord(metaData)
        Dim pipe As SqlPipe = SqlContext.Pipe
        pipe.SendResultsStart(record)
        Try
            For Each row As DataRow In dt.Rows
                For index As Integer = 0 To record.FieldCount - 1
                    Dim valueobj As Object = row(index)
                    record.SetValue(index, valueobj)
                Next

                pipe.SendResultsRow(record)
            Next
        Catch ex As Exception
            pipe.Send(ex.Message)
        Finally
            pipe.SendResultsEnd()
        End Try
    End Sub

    Private Shared Function ExtractDataTableColumnMetaData(dt As DataTable, ByRef coerceToString As Boolean()) As SqlMetaData()
        Dim metaDataResult As SqlMetaData() = New SqlMetaData(dt.Columns.Count - 1) {}
        coerceToString = New Boolean(dt.Columns.Count - 1) {}
        For index As Integer = 0 To dt.Columns.Count - 1
            Dim column As DataColumn = dt.Columns(index)
            metaDataResult(index) = SqlMetaDataFromColumn(column, coerceToString(index))
        Next

        Return metaDataResult
    End Function

    Private Shared Function InvalidDataTypeCode(code As TypeCode) As Exception
        Return New ArgumentException("Invalid type: " & Convert.ToString(code))
    End Function

    Private Shared Function UnknownDataType(clrType As Type) As Exception
        Return New ArgumentException("Unknown type: " & Convert.ToString(clrType))
    End Function

    Private Shared Function SqlMetaDataFromColumn(column As DataColumn, ByRef coerceToString As Boolean) As SqlMetaData
        coerceToString = False
        Dim smd As SqlMetaData = Nothing
        Dim clrType As Type = column.DataType
        Dim name As String = column.ColumnName
        Select Case Type.GetTypeCode(clrType)
            Case TypeCode.[Boolean]
                smd = New SqlMetaData(name, SqlDbType.Bit)
                Exit Select
            Case TypeCode.[Byte]
                smd = New SqlMetaData(name, SqlDbType.TinyInt)
                Exit Select
            Case TypeCode.[Char]
                smd = New SqlMetaData(name, SqlDbType.NVarChar, 1)
                Exit Select
            Case TypeCode.DateTime
                smd = New SqlMetaData(name, SqlDbType.DateTime)
                Exit Select
            Case TypeCode.DBNull
                Throw InvalidDataTypeCode(TypeCode.DBNull)
            Case TypeCode.[Decimal]
                smd = New SqlMetaData(name, SqlDbType.[Decimal], 18, 0)
                Exit Select
            Case TypeCode.[Double]
                smd = New SqlMetaData(name, SqlDbType.Float)
                Exit Select
            Case TypeCode.Empty
                Throw InvalidDataTypeCode(TypeCode.Empty)
            Case TypeCode.Int16
                smd = New SqlMetaData(name, SqlDbType.SmallInt)
                Exit Select
            Case TypeCode.Int32
                smd = New SqlMetaData(name, SqlDbType.Int)
                Exit Select
            Case TypeCode.Int64
                smd = New SqlMetaData(name, SqlDbType.BigInt)
                Exit Select
            Case TypeCode.[SByte]
                Throw InvalidDataTypeCode(TypeCode.[SByte])
            Case TypeCode.[Single]
                smd = New SqlMetaData(name, SqlDbType.Real)
                Exit Select
            Case TypeCode.[String]
                smd = New SqlMetaData(name, SqlDbType.NVarChar, column.MaxLength)
                Exit Select
            Case TypeCode.UInt16
                Throw InvalidDataTypeCode(TypeCode.UInt16)
            Case TypeCode.UInt32
                Throw InvalidDataTypeCode(TypeCode.UInt32)
            Case TypeCode.UInt64
                Throw InvalidDataTypeCode(TypeCode.UInt64)
            Case TypeCode.[Object]
                smd = SqlMetaDataFromObjectColumn(name, column, clrType)
                If smd Is Nothing Then
                    ' Unknown type, try to treat it as string; 
                    smd = New SqlMetaData(name, SqlDbType.NVarChar, column.MaxLength)
                    coerceToString = True
                End If
                Exit Select
            Case Else

                Throw UnknownDataType(clrType)
        End Select

        Return smd
    End Function

    Private Shared Function SqlMetaDataFromObjectColumn(name As String, column As DataColumn, clrType As Type) As SqlMetaData
        Dim smd As SqlMetaData = Nothing
        If clrType.Equals(GetType(System.Byte())) OrElse clrType.Equals(GetType(SqlBinary)) OrElse clrType.Equals(GetType(SqlBytes)) OrElse clrType.Equals(GetType(System.Char())) OrElse clrType.Equals(GetType(SqlString)) OrElse clrType.Equals(GetType(SqlChars)) Then
            smd = New SqlMetaData(name, SqlDbType.VarBinary, column.MaxLength)
        ElseIf clrType.Equals(GetType(System.Guid)) Then
            smd = New SqlMetaData(name, SqlDbType.UniqueIdentifier)
        ElseIf clrType.Equals(GetType(System.Object)) Then
            smd = New SqlMetaData(name, SqlDbType.[Variant])
        ElseIf clrType.Equals(GetType(SqlBoolean)) Then
            smd = New SqlMetaData(name, SqlDbType.Bit)
        ElseIf clrType.Equals(GetType(SqlByte)) Then
            smd = New SqlMetaData(name, SqlDbType.TinyInt)
        ElseIf clrType.Equals(GetType(SqlDateTime)) Then
            smd = New SqlMetaData(name, SqlDbType.DateTime)
        ElseIf clrType.Equals(GetType(SqlDouble)) Then
            smd = New SqlMetaData(name, SqlDbType.Float)
        ElseIf clrType.Equals(GetType(SqlGuid)) Then
            smd = New SqlMetaData(name, SqlDbType.UniqueIdentifier)
        ElseIf clrType.Equals(GetType(SqlInt16)) Then
            smd = New SqlMetaData(name, SqlDbType.SmallInt)
        ElseIf clrType.Equals(GetType(SqlInt32)) Then
            smd = New SqlMetaData(name, SqlDbType.Int)
        ElseIf clrType.Equals(GetType(SqlInt64)) Then
            smd = New SqlMetaData(name, SqlDbType.BigInt)
        ElseIf clrType.Equals(GetType(SqlMoney)) Then
            smd = New SqlMetaData(name, SqlDbType.Money)
        ElseIf clrType.Equals(GetType(SqlDecimal)) Then
            smd = New SqlMetaData(name, SqlDbType.[Decimal], SqlDecimal.MaxPrecision, 0)
        ElseIf clrType.Equals(GetType(SqlSingle)) Then
            smd = New SqlMetaData(name, SqlDbType.Real)
        ElseIf clrType.Equals(GetType(SqlXml)) Then
            smd = New SqlMetaData(name, SqlDbType.Xml)
        Else
            smd = New SqlMetaData(name, SqlDbType.NText)
        End If

        Return smd
    End Function


End Class
